home *** CD-ROM | disk | FTP | other *** search
/ Ham Radio / Ham Radio CD-ROM (Emerald Software) (1995).ISO / misc / utilitys / smath.bas (.txt) < prev    next >
Encoding:
GW-BASIC  |  1980-01-01  |  8.1 KB  |  263 lines
  1. 20  REM S PARAMETER NODE REDUCTION PROGRAM FOR MULTIPORT NETWORKS
  2. 40  REM written by David R Love , 7-10-84
  3. 50  PRINT:PRINT,"via K2UYH/wa2tif":PRINT
  4. 60  DIM L$(4)
  5. 80  FOR CL=1 TO 25 :PRINT :NEXT
  6. 100  REM PRECISION 4
  7. 120  GOSUB 2880
  8. 140  INPUT"DATA";U$
  9. 160  IF U$="ME" THEN 120
  10. 180  IF U$="LO" THEN 4400
  11. 200  IF U$="EX" THEN 3820
  12. 220  IF U$="HC" THEN PT=2:GOSUB 2880:PT=0:GOTO 140
  13. 240  REM INPUT DATA SECTION ****************************************
  14. 260  INPUT"INPUT NUMBER OF LINES";MC
  15. 280  INPUT "INPUT NUMBER OF NODES";NI
  16. 300  PRINT:DIM M(3,5*MC),A(3,4*MC)
  17. 320  FOR N=1 TO MC
  18. 340  PRINT "LINE NUMBER";N
  19. 360  INPUT "INPUT SOURCE NODE";A(0,N)
  20. 380  INPUT "INPUT LOAD NODE";A(1,N)
  21. 400  INPUT "INPUT REFLECTION/XMISSION COEF IN ANGULAR FORM";A(2,N),A(3,N)
  22. 420  PRINT  :NEXT
  23. 440  GOSUB 2720                           
  24. 460  REM MAIN DECISION BLOCK ***************************************
  25. 480  INPUT"MODS";U$
  26. 500  IF U$="CH" THEN GOSUB 4660
  27. 520  IF U$="DS" THEN D1=(D1+2)MOD4:PRINT"MATRIX DATA TURNED ";:IF D1=2 THEN PRINT"ON" ELSE PRINT"OFF"
  28. 540  IF U$="NS" THEN GOSUB 4880
  29. 560  IF U$="PR" THEN PR=2:GOSUB 2720:PR=0
  30. 580  IF U$="HC" THEN PT=2:GOSUB 2880:PT=0
  31. 600  IF U$="EN" THEN 5180
  32. 620  IF U$="PP" THEN PS=(PS+2)MOD4 :PRINT"PROCESS TO PRINTER ";:IF PS=2 THEN PRINT"ENABLED" ELSE PRINT"DISABLED"
  33. 640  IF U$="PA" THEN PX=(PX+2)MOD4 :PRINT"ANSWER TO ";:IF PX=2 THEN PRINT"PRINTER" ELSE PRINT"CRT"
  34. 660  IF U$="SA" THEN GOSUB 5060
  35. 680  IF U$="ME" THEN GOSUB 2880
  36. 700  IF U$="GP" THEN PR=2:PS=2:D1=2:PX=2:GOTO 760
  37. 720  IF U$<>"GO" THEN 480
  38. 740  REM POLAR TO RECTANGULAR *************************************
  39. 760  MD=MC:NJ=NI
  40. 770  IF D1=2 THEN GOSUB 2720
  41. 780  FOR X=1 TO MD
  42. 800  M(0,X)=A(0,X) :M(1,X)=A(1,X)
  43. 820  M(2,X)=A(2,X)*COS(PI*A(3,X)/180)
  44. 840  M(3,X)=A(2,X)*SIN(PI*A(3,X)/180)
  45. 860  NEXT X
  46. 870  PRINT,"POLAR TO RECTANGULAR"
  47. 880  IF D1=2 THEN GOSUB 2520
  48. 900  REM PARALLEL LINE REDUCTION SECTION **************************
  49. 920  FOR J=1 TO MD-1
  50. 940  FOR K=J+1 TO MD
  51. 960  IF M(0,J)=0 THEN 1160
  52. 980  IF M(0,J)=M(0,K) AND M(1,J)=M(1,K) THEN 1040
  53. 1000  GOTO 1160
  54. 1020  REM ADD LINE J TO LINE K
  55. 1040  M(2,J)=M(2,J) + M(2,K)
  56. 1060  M(3,J)=M(3,J) + M(3,K)
  57. 1080  REM CANCEL LINE K
  58. 1100  M(0,K)=0 :M(1,K)=0
  59. 1120  PRINT ,"PARALLEL REDUCTION"
  60. 1140  IF D1=2 THEN GOSUB 2520
  61. 1160  NEXT :NEXT
  62. 1180  IF NJ=2 THEN 2040
  63. 1200  REM NODE REDUCTION SECTION **********************************
  64. 1220  FOR X=1 TO MD
  65. 1240  IF M(0,X)<>NJ THEN 1500
  66. 1260  AF=0
  67. 1280  FOR Y=1 TO MD
  68. 1300  IF M(1,Y)<>NJ THEN 1460
  69. 1320  AF=AF+1
  70. 1340  IF M(0,AF)<>0 THEN 1320
  71. 1360  M(0,AF)=M(0,Y):M(1,AF)=M(1,X)
  72. 1380  M(2,AF)=M(2,X)*M(2,Y)-M(3,X)*M(3,Y)
  73. 1400  M(3,AF)=M(2,X)*M(3,Y)+M(3,X)*M(2,Y)
  74. 1420  IF AF>HT THEN HT=AF  
  75. 1440  NK=NJ
  76. 1460  NEXT Y
  77. 1480  M(0,X)=0:M(1,X)=0
  78. 1500  NEXT X
  79. 1520  FOR Z=1 TO MD
  80. 1540  IF M(1,Z)=NJ THEN M(0,Z)=0:M(1,Z)=0
  81. 1560  NEXT Z
  82. 1580  MD=HT
  83. 1600  IF NJ<>NK THEN PRINT"ILLEGAL FLOWGRAPH":PRINT:GOTO 720
  84. 1620  PRINT #PS,"NODE REDUCTION"
  85. 1640  IF D1=2 THEN GOSUB 2520
  86. 1660  REM "SELF LOOP REDUCTION" ************************************
  87. 1680  FOR J=1 TO MD
  88. 1700  IF M(0,J)<>M(1,J) OR M(0,J)=0 THEN 2000
  89. 1720  REM SUBTRACT 1
  90. 1740  M(2,J)=1-M(2,J)
  91. 1760  FOR K=1 TO MD
  92. 1780  IF M(1,K)=M(0,J) AND J<>K THEN 1840
  93. 1800  GOTO 1920
  94. 1820  REM COMPLEX DIVISION
  95. 1840  ST=M(2,J)*M(2,J)+M(3,J)*M(3,J)
  96. 1860  MEM=M(2,K)
  97. 1880  M(2,K)=(M(2,K)*M(2,J)+M(3,K)*M(3,J))/ST
  98. 1900  M(3,K)=(M(3,K)*M(2,J)-MEM*M(3,J))/ST
  99. 1920  NEXT K
  100. 1940  M(0,J)=0:M(1,J)=0
  101. 1960  PRINT ,"SELF LOOP"
  102. 1980  IF D1=2 THEN GOSUB 2520
  103. 2000  NEXT J:NJ=NJ-1:GOTO 920:REM RESTART
  104. 2020  REM "FINAL SECTION ******************************************
  105. 2040  FOR X=1 TO MD
  106. 2060  IF M(0,X)=1 THEN A=X
  107. 2080  IF M(0,X)=2 THEN B=X
  108. 2100  NEXT X
  109. 2120  IF B=0 THEN X=M(2,A):Y=M(3,A):GOTO 2320
  110. 2140  CR=M(2,A)*M(2,B)-M(3,A)*M(3,B)
  111. 2160  CI=M(2,A)*M(3,B)+M(3,A)*M(2,B)
  112. 2180  CR=1-CR
  113. 2200  REM DIVIDE
  114. 2220  PRINT ,"REVERSION"
  115. 2240  ST=CR*CR+CI*CI
  116. 2260  X=(M(2,A)*CR+M(3,A)*CI)/ST
  117. 2280  Y=(M(3,A)*CR-M(2,A)*CI)/ST
  118. 2300  IF D1=2 THEN PRINT:PRINT,"REAL","IMAGINARY":PRINT,X,Y:PRINT
  119. 2320  J=SQR(X*X+Y*Y)
  120. 2340  K=180*ATN(Y/X)/PI
  121. 2360  IF X<0 THEN K=K+180
  122. 2380  PRINT
  123. 2400  PRINT,"THE ANSWER IS"
  124. 2420  PRINT,J;"MAGNITUDE",K;"DEGREES"
  125. 2440  PRINT
  126. 2460  PR=0
  127. 2480  GOTO 480
  128. 2500  REM DEBUGGING SECTION *************************************
  129. 2520  PRINT
  130. 2540  PRINT ,"LINE","SOURCE","LOAD","REAL","IMAGINARY"
  131. 2560  FOR DP=1 TO MD
  132. 2580  PRINT ,DP,M(0,DP),M(1,DP),M(2,DP),M(3,DP)
  133. 2600  NEXT
  134. 2620  PRINT :PRINT :PRINT
  135. 2640  REM IF PR=2 THEN RETURN
  136. 2660  INPUT U$
  137. 2680  RETURN
  138. 2700  REM ANGULAR MATRIX PRINTOUT **********************************
  139. 2720  LPRINT
  140. 2740  LPRINT ,"LINE","SOURCE","LOAD","MAGNITUDE","ANGLE"
  141. 2760  FOR DP=1 TO MC
  142. 2780  LPRINT,DP,A(0,DP),A(1,DP),A(2,DP),A(3,DP)
  143. 2800  NEXT
  144. 2820  LPRINT: LPRINT: LPRINT
  145. 2840  RETURN
  146. 2860  REM MENU SECTION ***********************************************
  147. 2880  PRINT ,"                        MENU   PAGE 1"
  148. 2900  PRINT ,
  149. 2920  PRINT ,"THIS PROGRAM WILL TAKE A MULTIPORT S PARAMETER NETWORK AND REDUCE"
  150. 2940  PRINT ,"IT THRU FLOW GRAPH TECNIQUES TO A SINGLE S PARAMETER BETWEEN"
  151. 2960  PRINT ,"NODES 1 AND 2. *"
  152. 2980  PRINT ,
  153. 3000  PRINT ,"THE PROGRAM REQUIRES THAT REFLECTION/XMISSION COEF DATA BE IN POLAR"
  154. 3020  PRINT ,"FORM, WITH A MAGNITUDE BETWEEN 0 AND 1, AND AN ANGLE BETWEEN 0 AND"
  155. 3040  PRINT ,"360 DEGREES. (INCIDENTALLY COMPUTATION IS DONE RECTANGULARLY.)"
  156. 3060  PRINT,
  157. 3080  PRINT ,"MODIFICATIONS MAY BE MADE TO THE INPUTTED DATA AT THE APPROPRIATE"
  158. 3100  PRINT ,"POINTS DURING THE PROGRAM THRU THE USE OF THE KEY SYMBOLS LISTED"
  159. 3120  PRINT ,"BELOW."
  160. 3140  PRINT ,
  161. 3160  PRINT ,"ADDITIONALLY, MATRIX DATA MAY BE SAVED AND RECALLED TO THE DISC"
  162. 3180  PRINT ,"USING THE PROPER KEY SYMBOLS LISTED BELOW."
  163. 3200  PRINT ,:PRINT ,
  164. 3220  PRINT ,"  * EACH S PARAMETER IS DEFINED IN THE MATRIX BY A LINE NUMBER"
  165. 3240  PRINT ,"    WHICH SPECIFIES THE SOURCE NODE, LOAD NODE, AND REFLECTION/XMISSION
  166. 3260  PRINT ,"    COEFFICIENT MAGNITUDE AND ANGLE."
  167. 3280  PRINT ,:PRINT ,
  168. 3300  INPUT "             TO CONTINUE PRESS <RETURN>";U$
  169. 3320  PRINT ,:PRINT ,:PRINT ,:PRINT ,
  170. 3340  PRINT ,"                   MENU   PAGE 2
  171. 3360  PRINT ,:PRINT ,
  172. 3380  PRINT ,"SYMBOL                     EXPLANATION"
  173. 3400  PRINT ,"------                     -----------"
  174. 3420  PRINT ,"  EX    WILL CAUSE THE COMPUTER TO EXECUTE EXAMPLE PROGRAM."
  175. 3440  PRINT ,"        (ONLY POSSIBLE AFTER THE FIRST MENUE LISTING.)"
  176. 3460  PRINT ,"  CH    CHANGE LINE DATA. "
  177. 3480  PRINT ,"  NS    NODE SWITCH, THIS SUBROUTINE MAKES IT POSSIBLE TO"
  178. 3500  PRINT ,"        REDEFINE NODES 1 AND 2."
  179. 3520  PRINT ,"  PR    PRINT MODIFIED MATRIX DATA.(LINE PRINTER)
  180. 3540  PRINT ,"  HC    HARD COPY OF MENU.
  181. 3560  PRINT , " DS    MATRIX DISPLAY OF COMPUTATIONS. PROMPTING IS REQUIRED"
  182. 3580  PRINT ,"        TO ADVANCE IN THIS MODE."
  183. 3600  PRINT ,"  EN    EXIT PROGRAM TO XDB.
  184. 3620  PRINT ,"  PP    CAUSES REDUCTION PROCESSES TO LIST TO LINE PRINTER.
  185. 3640  PRINT ,"  PA    CAUSES ANSWER TO LIST TO LINE PRINTER.
  186. 3660  PRINT ,"  GO    INITIATES COMPUTATION.
  187. 3680  PRINT ,"  SA    MATRIX STORE TO DISC."
  188. 3700  PRINT ,"  LO    MATRIX LOAD FROM DISC. (ONLY POSSIBLE AFTER THE FIRST"
  189. 3720  PRINT,"        MENU LISTING.)"
  190. 3740  PRINT,"  ME    REDISPLAY MENU TO CRT.
  191. 3760  PRINT,:PRINT,
  192. 3780  RETURN
  193. 3800  REM EXAMPLE SECTION *******************************************
  194. 3820  FOR X=1 TO 18 :PRINT:NEXT
  195. 3840  PRINT "THIS EXAMPLE IS FOR A 3 PORT DIRECTIONAL COUPLER. THE COUPLING"
  196. 3860  PRINT "IS 10DB, INSERTION LOSS IS 1.2DB, DIRECTIVITY IS 25DB. THE"
  197. 3880  PRINT "PHASE ANGLES WERE ARBITRARILY CHOSEN. THE LOAD AND DEVICE"
  198. 3900  PRINT "VSWR'S ARE 1.5 AND 1.25 RESPECTIVELY. PRESS THE CARRIAGE"
  199. 3920  PRINT "RETURN TO PROMPT THE EXAMPLE PROGRAM TO CONTINUE."
  200. 3940  L$(0)="INPUT NUMBER OF LINES  "
  201. 3960  L$(1)="INPUT NUMBER OF NODES  "
  202. 3980  L$(2)="INPUT SOURCE NODE  "
  203. 4000  L$(3)="INPUT LOAD NODE  "
  204. 4020  L$(4)="INPUT REFLECTION/XMISSION COEF IN POLAR FORM  "
  205. 4040  PRINT
  206. 4060  PRINT L$(0);12 :MC=12
  207. 4080  PRINT L$(1);6 :NI=6
  208. 4100  INPUT U$
  209. 4120  DIM A(3,48),M(3,60)
  210. 4140  FOR X=1 TO 12
  211. 4160  PRINT 
  212. 4180  PRINT "LINE NUMBER";X
  213. 4200  READ DA :PRINT L$(2);DA :A(0,X)=DA
  214. 4220  READ DA :PRINT L$(3);DA :A(1,X)=DA
  215. 4240  READ DA,DB :PRINTL$(4);DA;DB :A(2,X)=DA :A(3,X)=DB
  216. 4260  INPUT U$
  217. 4280  NEXT X
  218. 4300  GOTO 440
  219. 4320  DATA 6,1,.80,10,1,6,.89,20,1,2,.48,30,3,6,.48,30
  220. 4340  DATA 2,3,.80,50,3,2,.89,60,1,4,.93,70,5,6,.93,70
  221. 4360  DATA 3,4,.10,90,5,2,.10, 90,5,4,.89,110,4,5,.80,120
  222. 4380  REM FILE LOAD FROM DISC **********************************
  223. 4400  PRINT:INPUT"FILE NAME OR DIR";F$
  224. 4420  IF F$="DIR" THEN DIR"*.SMA":GOTO4400
  225. 4440  F$=F$+".SMA"
  226. 4460  IF LOOKUP(F$)=0 THEN PRINT"FILE NOT FOUND":GOTO 4400
  227. 4480  OPEN#1,"I",F$
  228. 4500  READ#1,MC,NI
  229. 4520  DIM A(3,4*MC),M(3,5*MC)
  230. 4540  FOR X=1 TO MC:FOR Y=0 TO 3
  231. 4560  READ#1,A(Y,X):NEXT:NEXT
  232. 4580  PRINT"FILE LOADED INTO MATRIX"
  233. 4600  CLOSE#1
  234. 4620  GOSUB 2700:GOTO 480
  235. 4640  REM CHANGE SECTION *****************************************
  236. 4660  PRINT:INPUT"INPUT LINE NUMBER TO BE CHANGED";LN
  237. 4680  IF LN>MC THEN MC=LN
  238. 4700  PRINT:PRINTA(0,LN),A(1,LN),A(2,LN),A(3,LN)
  239. 4720  PRINT:PRINT
  240. 4740  INPUT "INPUT SOURCE NODE";A(0,LN)
  241. 4760  IF A(0,LN)>NI THEN NI=A(0,LN)
  242. 4780  INPUT"INPUT LOAD NODE";A(1,LN)
  243. 4800  IF A(1,LN)>NI THEN NI=A(1,LN)
  244. 4820  INPUT"INPUT REFLECTION/XMISSION COEF IN POLAR FORM";A(2,LN),A(3,LN)
  245. 4840  GOSUB 2720:RETURN
  246. 4860  REM NODE SWITCH SUB ************************************
  247. 4880  PRINT:INPUT"INPUT NODE # TO REPLACE NODE 1";NA
  248. 4900  INPUT "INPUT NODE # TO REPLACE NODE 2";NB
  249. 4920  FOR X=1 TO MC:FOR Y=0 TO 1
  250. 4940  IF A(Y,X)=1 THEN A(Y,X)=NA:GOTO 5020
  251. 4960  IF A(Y,X)=2 THEN A(Y,X)=NB:GOTO 5020
  252. 4980  IF A(Y,X)=NA THEN A(Y,X)=1
  253. 5000  IF A(Y,X)=NB THEN A(Y,X)=2
  254. 5020  NEXT: NEXT:GOSUB 2700:RETURN
  255. 5040  REM SAVE TO DISC ******************************************
  256. 5060  PRINT:INPUT"FILE NAME";F$:F$=F$+".SMA"
  257. 5080  ERASE F$:OPEN#1,"O",F$
  258. 5100  WRITE#1,MC,NI
  259. 5120  FOR X=1 TO MC:FOR Y=0 TO 3
  260. 5140  WRITE#1,A(Y,X):NEXT:NEXT
  261. 5160  CLOSE#1:RETURN
  262. 5180  END
  263.